Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/user2grp.fr_/user2grp.fr

Text File | 1995-07-06 | 6KB | 206 lines

VERSION 4.00
Begin VB.Form frmMain
   BackColor       =   &H00C0C0C0&
   Caption         =   "Add User to Group"
   ClientHeight    =   2100
   ClientLeft      =   1890
   ClientTop       =   2055
   ClientWidth     =   4770
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   2505
   Left            =   1830
   LinkTopic       =   "Form1"
   ScaleHeight     =   2100
   ScaleWidth      =   4770
   Top             =   1710
   Width           =   4890
   Begin VB.CommandButton cmdShowUsers
      Caption         =   "&Show Users"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3240
      TabIndex        =   6
      Top             =   600
      Width           =   1215
   End
   Begin VB.ComboBox cboGroups
      Height          =   300
      Left            =   960
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   600
      Width           =   2115
   End
   Begin VB.ComboBox cboUsers
      Height          =   300
      Left            =   990
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   120
      Width           =   2115
   End
   Begin VB.CommandButton cmdClose
      Cancel          =   -1  'True
      Caption         =   "Cl&ose"
      Height          =   555
      Left            =   2520
      TabIndex        =   1
      Top             =   1200
      Width           =   1755
   End
   Begin VB.CommandButton cmdAddUser
      Caption         =   "&Add User"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   555
      Left            =   480
      TabIndex        =   0
      Top             =   1200
      Width           =   1755
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Group"
      Height          =   195
      Left            =   180
      TabIndex        =   5
      Top             =   660
      Width           =   525
   End
   Begin VB.Label Label2
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "&User:"
      Height          =   195
      Left            =   240
      TabIndex        =   3
      Top             =   180
      Width           =   465
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

#If Win32 Then
    Private Declare Function GetWindowsDirectory Lib "kernel32" _
        Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, _
        ByVal nSize As Long) As Long
#Else
    Private Declare Function GetWindowsDirectory Lib "Kernel" _
        (ByVal lpBuffer As String, _
        ByVal nSize As Integer) As Integer
#End If




Private Sub cboGroups_Click()
    cmdAddUser.Enabled = IIf(cboUsers.ListIndex = -1 Or cboGroups.ListIndex = -1, False, True)
    cmdShowUsers.Enabled = IIf(cboGroups.ListIndex = -1, False, True)
End Sub
Private Sub cboUsers_Click()
    cmdAddUser.Enabled = IIf(cboUsers.ListIndex = -1 Or cboGroups.ListIndex = -1, False, True)
End Sub

Private Sub cmdShowUsers_Click()
    frmUsers.Tag = cboGroups.TEXT
    frmUsers.Show 1
End Sub

Private Sub Form_Load()
    Dim myUser As String, myPass As String
    Dim winDir As String * 128
    Dim dirLen As Integer

    ' On Error GoTo LoadError
    ' Get the Windows directory and set the INI path.
    dirLen = GetWindowsDirectory(winDir, 128)
    If dirLen = 0 Then Error 32767
    DBEngine.IniPath = Left$(winDir, dirLen) & "\VBDBHT.INI"

    ' Set the user and passwords for initial login.
    myUser = "Admin"
    myPass = "theboss"
    DBEngine.DefaultUser = myUser
    DBEngine.DefaultPassword = myPass

    FillUserList
    FillGroupList

Exit Sub
LoadError:
    MsgBox Err & " " & Error$
End

End Sub

Private Sub cmdAddUser_Click()
    Dim newGroup As GROUP
    Dim thePID As String
    Dim usr As User

    On Error GoTo ChangeError

    ' If the user has not selected both a user and a group, generate an error
    If cboUsers.ListIndex = -1 Then Error 32765
    If cboGroups.ListIndex = -1 Then Error 32764

    ' Add the user to the designated group.
    Set usr = DBEngine.Workspaces(0).Groups(cboGroups.TEXT).CreateUser(cboUsers.TEXT)
    DBEngine.Workspaces(0).Groups(cboGroups.TEXT).Users.Append usr

    ' No errors, so must have been successful.
    MsgBox "User " & cboUsers.TEXT & " added to " & cboGroups.TEXT, vbInformation
Exit Sub

ChangeError:
    Dim msg As String
    Select Case Err.Number
        Case 3032
            msg = "User " & cboUsers.TEXT & " already belongs to Group " & cboGroups.TEXT
        Case 32765
            msg = "You have not selected a user."
        Case 32764
            msg = "You have not selected a group."
        Case Else
            msg = Err.Description
    End Select
    MsgBox msg, vbExclamation
End Sub

Sub FillUserList()
    Dim usr As User

    For Each usr In DBEngine.Workspaces(0).Users
        If UCase$(usr.Name) <> "CREATOR" And UCase$(usr.Name) <> "ENGINE" Then
            cboUsers.AddItem usr.Name
        End If
    Next
End Sub
Sub FillGroupList()
    Dim grp As GROUP

    For Each grp In DBEngine.Workspaces(0).Groups
        cboGroups.AddItem grp.Name
    Next
End Sub
Private Sub cmdClose_Click()
    End
End Sub